SGI Freeware 1999 August/SGI Freeware 1999 August.iso/dist/fw_tkcvs.idb/usr/freeware/lib/tkcvs/bindings.tcl.z/bindings.tcl

Text File | 1999-04-16 | 30.2 KB | 1,199 lines

# $Id: bindings.tcl,v 1.1 1995/01/14 11:27:00 del Exp $
#
# This code taken from tkMail by Paul Raines ([e-mail])
#
# Gives more motif-like ands emacs-like bindings to Text and Entry Widgets
#
global bind_xnd btp

# USER SETTINGS

# maximum number of kills to save in ring
set btp(maxkill) 10
# maximum number of marks to save in ring
set btp(maxmark) 10
# syntax for letter not part of a "word"
set btp(not-word) {[^a-zA-Z_0-9]}
# procedure to use for errors
set btp(error) error
# procedure to use for beeping
set btp(beep) ""
# whether to bind Escape prefix commands also to the Meta modifier
set btp(use-meta) 1
# column at which to line wrap
set btp(fillcol) 0
# prefix for line wrapping (NOT REALLY WORKING YET)
set btp(fillprefix) ""

# PRIVATE SETTINGS

set btp(lastkill) 0.0
set btp(killring) ""
set btp(killptr) 0
set btp(killlen) 0
set btp(arg) def

proc tk_entryForwspace w {
     set x [expr [$w index insert] - 1]
     catch {$w delete $x}
}

# selection_if_any - return selection if it exists, else {}
#   this is from [e-mail] (R. James Noble)
proc selection_if_any {} {
  if {[catch {selection get} s]} {return ""} {return $s}
}

proc bind_cleanup { w } {
    global btp
    catch {unset btp($w,markring)}
}

proc bt:current-line { w } {
    return [lindex [split [$w index insert] .] 0]
}

proc bt:current-col { w } {
    return [lindex [split [$w index insert] .] 1]
}

proc bt:move-line { w {num 1} } {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
    }
    if {$btp(prevcmd) != "move-line"} {
        set btp(goalcol) [lindex [split [$w index insert] .] 1]
    }
    if {$num > -1} {set num "+$num"}
    $w tag remove sel 1.0 end
    set ndx [$w index "insert $num line lineend"]
    set goalndx [lindex [split $ndx .] 0].$btp(goalcol)
    if {$btp(goalcol) < [lindex [split $ndx .] 1]} {
        $w mark set insert $goalndx
    } else {
        $w mark set insert $ndx
    }
    $w yview -pickplace insert
    set btp(prevcmd) move-line
}

proc bt:move-char { w {num 1} } {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
    }
    if {$num > -1} {set num "+$num"}
    $w tag remove sel 1.0 end
    $w mark set insert "insert $num char"
    $w yview -pickplace insert
    set btp(prevcmd) "move-char"
}

proc bt:move-word {w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
    }
    if {$num > 0} {
        for {set i 0} {$i < $num } {incr i} {
        while {[regexp $btp(not-word) [$w get insert]]} {
            $w mark set insert insert+1c
        }
        $w mark set insert {insert wordend}
    }
    } else {
        for {set i 0} {$i > $num } {incr i -1} {
        $w mark set insert insert-1c
        while {[regexp $btp(not-word) [$w get insert]]} {
            $w mark set insert insert-1c
        }
        $w mark set insert {insert wordstart}
    }
    }
    $w yview -pickplace insert
    set btp(prevcmd) "move-word"
}

proc bt:begin-line { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    if {$num != 0} {set num [expr $num-1]}
    bt:move-line $w $num
    $w mark set insert {insert linestart}
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) "begin-line"
}

proc bt:end-line { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    if {$num != 0} {set num [expr $num-1]}
    bt:move-line $w $num
    $w mark set insert {insert lineend}
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) end-line
}

proc bt:begin-buffer { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    bt:set-mark $w
    set ndx [expr 1+[lindex [split [$w index end] .] 0]*$num/10]
    $w mark set insert $ndx.0
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) begin-buffer
}

proc bt:end-buffer { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    bt:set-mark $w
    set ndx [expr [lindex [split [$w index end] .] 0]*$num/10]
    $w mark set insert "end - $ndx lines"
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) end-buffer
}

proc bt:scroll-next { w {num 1}} {
    global  btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    $w tag remove sel 1.0 end
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    $w mark set insert [lindex [$scr get] 3].0
    $w yview insert-1l
    set btp(prevcmd) scroll-next
}

proc bt:scroll-prior { w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    $w tag remove sel 1.0 end
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    set tndx [expr [lindex [$scr get] 2]-[lindex [$scr get] 1]+5].0
    if {$tndx < 1.0} {set tndx 1.0}
    $w mark set insert $tndx
    $w yview insert-1l
    set btp(prevcmd) scroll-prior
}

proc bt:delete-word { w {num 1}} {
    global btp
    $w tag remove sel 1.0 end
    if {[$w compare $btp(lastkill) == insert]} {
    set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    bt:move-word $w $num
    puts "$num : $beg [$w index insert]"
    if {$beg < [$w index insert]} {
        bt:push-cut "$lastcut[$w get $beg insert]"
        $w delete $beg insert
    } else {
        bt:push-cut "[$w get insert $beg]$lastcut"
        $w delete insert $beg
    }
    set btp(lastkill) [$w index insert]
    $w yview -pickplace insert
    set btp(prevcmd) delete-word
}

proc bt:delete-line { w {num 0}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    if {[$w compare $btp(lastkill) == insert]} {
    set lastcut [bt:pop-cut]
    } else { set lastcut ""}
    while {[$w get insert] == " "} {
    $w mark set insert insert+1c
    }
    if {[$w compare insert == "insert lineend"] && $num == 0} { set num 1 }
    set beg [$w index insert]
    if {$num != 0} {
    bt:move-line $w $num
    bt:begin-line $w
    if {$beg < [$w index insert]} {
        bt:push-cut "$lastcut[$w get $beg insert]"
        $w delete $beg insert
    } else {
        bt:push-cut "[$w get insert $beg]$lastcut"
        $w delete insert $beg
    }
    } else {
      bt:push-cut "$lastcut[$w get insert {insert lineend}]"
      $w delete insert {insert lineend};
      $w yview -pickplace insert
    }
    $w yview -pickplace insert
    set btp(lastkill) [$w index insert]
    set btp(prevcmd) delete-line
}

proc bt:delete-back-char-or-sel { w {num 1} } {
    global btp
    if {$btp(arg) != "def"} {
        set num $btp(arg)
    } else {set btp(lastkill) 0.0}
    set num [expr -1*$num]
    if {$num > -1} {set num "+$num"}
    if {[$w compare $btp(lastkill) == insert]} {
    set lastcut [bt:pop-cut]
    } else { set lastcut ""}
    if [catch {set tmp [$w get sel.first sel.last]}] {
        if {$btp(arg) != "def"} {
        if {$num < 0} {
        bt:push-cut "[$w get "insert $num char" insert]$lastcut"
            $w delete "insert $num char" insert
        } else {
        bt:push-cut "$lastcut[$w get insert "insert $num char"]"
            $w delete insert "insert $num char"
        }
        set btp(lastkill) [$w index insert]
        } else {
        if {$num < 0} {
            $w delete "insert $num char" insert
        } else {
            $w delete insert "insert $num char"
        }
        set btp(lastkill) 0.0
        }
    } else {
    $w delete sel.first sel.last
    bt:push-cut $tmp
        set btp(lastkill) 0.0
    }
    set btp(arg) def
    $w yview -pickplace insert
    set btp(prevcmd) delete-back-char-or-sel
}

proc bt:delete-region-or-sel { w } {
    global btp

    if {[catch {set tmp [$w get sel.first sel.last]}]} {
    if {[catch "$w index emacs"]} {
        $btp(error) "No emacs mark has been set yet!"
    }
        if {[$w compare $btp(lastkill) == insert]} {
        set lastcut [bt:pop-cut]
        } else { set lastcut ""}
    if {[$w compare emacs < insert]} {
        bt:push-cut "$lastcut[$w get emacs insert]"
        $w delete emacs insert
    } else {
        bt:push-cut "[$w get insert emacs]$lastcut"
        $w delete insert emacs
    }
        set btp(lastkill) [$w index insert]
    } else {
    $w delete sel.first sel.last
    bt:push-cut $tmp
        set btp(lastkill) 0.0
    }
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

proc bt:copy-region-or-sel { w } {
    global btp

    if {[catch {set tmp [$w get sel.first sel.last]}]} {
    if {[catch "$w index emacs"]} {
        $btp(error) "No emacs mark has been set yet!"
    }
        if {[$w compare $btp(lastkill) == insert]} {
        set lastcut [bt:pop-cut]
        } else { set lastcut ""}
    if {[$w compare emacs < insert]} {
        bt:push-cut "$lastcut[$w get emacs insert]"
    } else {
        bt:push-cut "[$w get insert emacs]$lastcut"
    }
    bt:exchange-point-and-mark $w
    after 200 bt:exchange-point-and-mark $w
    } else {
    bt:push-cut $tmp
    }
    set btp(arg) def
    set btp(lastkill) 0.0
    set btp(prevcmd) copy-region-or-sel
}

proc bt:append-next-kill { w } {
    global btp
    set btp(lastkill) [$w index insert]
}

proc bt:push-cut { txt } {
    global btp

    set btp(killlen) [llength [lappend btp(killring) $txt]]
    if { $btp(killlen) > $btp(maxkill)} {
    set btp(killring) [lreplace $btp(killring) 0 0]
    incr btp(killlen) -1
    }
    set btp(killptr) 0
}

proc bt:pop-cut { } {
    global btp

    if {$btp(killlen) == 0} {return ""}
    set txt [bt:get-cut 1]
    set ndx [expr $btp(killlen)-1]
    set btp(killring) [lreplace $btp(killring) $ndx $ndx ]
    incr btp(killlen) -1
    set btp(killptr) 0
    return $txt
}

proc bt:get-cut { {ndx 1} } {
    global btp

    set ndx [expr $ndx+$btp(killptr)]
    set btp(killptr) [expr $ndx-1]
    set ndx [expr $ndx%$btp(killlen)]
    if {$ndx == 0} {set ndx $btp(killlen)}
    return [lindex $btp(killring) [expr $btp(killlen)-$ndx]]

}

proc bt:yank { w {num 1}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    set btp(lastkill) 0.0
    set tmp [$w index insert]
    $w insert insert [bt:get-cut $num]
    $w mark set emacs $tmp
    $w yview -pickplace insert
    set btp(prevcmd) yank
}

proc bt:yank-pop { w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    if {$btp(prevcmd) != "yank"} return
    $w tag remove sel 1.0 end
    $w delete emacs insert
    set tmp [$w index insert]
    $w insert insert [bt:get-cut [expr $num+1]]
    $w mark set emacs $tmp
    $w yview -pickplace insert
}

proc bt:pop-mark { w } {
    global btp
    set ndx [expr [llength $btp($w,markring)]-1]
    set oldmark [lindex $btp($w,markring) $ndx]
    $w mark set emacs $oldmark
    set btp($w,markring) [concat $oldmark [lreplace $btp($w,markring) $ndx $ndx]]
}

proc bt:push-mark { w ndx } {
    global btp
    lappend btp($w,markring) $ndx
}

proc bt:set-mark { w {num def}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    if {$num != "def"} {
    if {[catch "$w index emacs"]} {
        $btp(error) "No emacs mark has been set yet!"
    }
        $w yview -pickplace insert
        bt:pop-mark $w
        $w mark set insert emacs
    } else {
    bt:push-mark $w [$w index insert]
        $w mark set emacs insert
    }
    set btp(lastkill) 0.0
    set btp(prevcmd) set-mark
}

proc bt:exchange-point-and-mark { w } {
    global btp
    if {[catch "$w index emacs"]} {
    $btp(error) "No emacs mark has been set yet!"
    }
    set tmp [$w index insert]
    $w mark set insert emacs
    $w mark set emacs $tmp
    set btp(lastkill) 0.0
    set btp(prevcmd) set-mark
}

proc bt:open-line {w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    catch {$w delete sel.first sel.last}
    for {set i 0} {$i < $num } {incr i} {
        $w insert insert \n
    }
    $w mark set insert insert-1c
    $w yview -pickplace insert
    set btp(prevcmd) open-line
}

proc bt:argkey { w a } {
    global btp
    set btp(arg) $a
}

proc bt:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
    catch {%W delete sel.first sel.last}
    $w insert insert $a
    if {$btp(fillcol) && [bt:current-col $w] >= $btp(fillcol)} {
        bt:wrap-word $w
    }
    $w yview -pickplace insert
    set btp(lastkill) 0.0
    set btp(prevcmd) self-insert
    } else {
    if {$a == "-"} {
        if {$btp(arg) == "-"} {
        set btp(arg) "0"
        } elseif {$btp(arg) == "0"} {
        set btp(arg) "-"
        } else {
        set btp(arg) [expr -1*$btp(arg)]
        }
    } else {
        append btp(arg) $a
    }
    }
}

proc bt:univ-arg { w } {
    global btp
    if {$btp(arg) == "def"} {
    set btp(arg) 4
    } else {
    if {$btp(arg) == "-"} {
        set btp(arg) "-4"
    } else {
        set btp(arg) [expr 4*$btp(arg)]
    }
    }
}

proc bt:wrap-word { w } {
    global btp

    bt:move-word $w -1
    $w insert insert \n
    bt:end-line $w
}

proc bt:set-fill-col { w {num 0}} {
    global btp
    if {$btp(arg) == "def"} {
    if {$num < 1} {
        set btp(fillcol) [bt:current-col $w]
    } else {
        set btp(fillcol) $num
    }
    } else {
    if {$btp(arg) < 1} {
        set btp(fillcol) [bt:current-col $w]
    } else {
        set btp(fillcol) $btp(arg)
    }
    }
    set btp(arg) def
    set btp(lastkill) 0.0
    set btp(prevcmd) set-fill-col
}

proc bind_motiftext { tw } {
    global bind_xnd

    bind $tw <Control-KeyPress> {
        global btp
    if {"%A" != ""} {eval $btp(beep) }
    }

    # Some better bindings for text and entry
    bind $tw <Up> {bt:move-line %W -1}
    bind $tw <Down> {bt:move-line %W 1}
    bind $tw <Left> {bt:move-char %W -1}
    bind $tw <Right> {bt:move-char %W 1}
    bind $tw <Home> {bt:begin-line %W}
    bind $tw <End> {bt:end-line %W}
    bind $tw <Control-Home> {bt:begin-buffer %W}
    bind $tw <Control-End> {bt:end-buffer %W}
    bind $tw <Control-Left> {bt:move-word %W -1}
    bind $tw <Control-Right> {bt:move-word %W 1}
    bind $tw <Next> {bt:scroll-next %W}
    bind $tw <Prior> {bt:scroll-prior %W}

    bind $tw <Any-KeyPress> {
    global btp
    set num 1
    if {"%A" != ""} {
        if {$btp(arg) != "def"} {
        set num $btp(arg)
        set btp(arg) def
        }
        catch {%W delete sel.first sel.last}
        for {set i 0} { $i < $num} {incr i} {%W insert insert %A}
        if {$btp(fillcol) && [bt:current-col %W] >= $btp(fillcol)} {
        if {"%A" == " "} {
            %W insert insert \n
        } elseif {"%A" == "\t"} {
            %W insert insert \n\t
        } else {
            bt:wrap-word %W
        }
        }
        %W yview -pickplace insert
        set btp(lastkill) 0.0
        set btp(prevcmd) self-insert
    }
    }

    bind $tw <KeyPress-Return> {
    global btp
        catch {%W delete sel.first sel.last}
    set num 1
    if {$btp(arg) != "def"} {
        set num $btp(arg)
        set btp(arg) def
    }
        for {set i 0} { $i < $num} {incr i} {%W insert insert "\n"}
        %W yview -pickplace insert
    set btp(lastkill) 0.0
    set btp(prevcmd) newline
    }

    bind $tw <KeyPress-Delete> {bt:delete-back-char-or-sel %W -1}
    bind $tw <KeyPress-BackSpace> {bt:delete-back-char-or-sel %W 1}

    bind $tw <1> "[bind Text <1>]; \
                  global btp; set btp(lastkill) 0.0; \
          set btp(prevcmd) mouse-set"
    bind $tw <3> {%W tag remove sel 1.0 end}
    bind $tw <B1-Motion> {bind_textB1motion %W @%x,%y}

    set bind_xnd(b2-time) 0
    set bind_xnd(b2-y) 0
    bind $tw <2> {
        global bind_xnd
        %W scan mark %y
        set bind_xnd(b2-time) %t
        set bind_xnd(b2-y) %y
    }
    bind $tw <ButtonRelease-2> {
        global bind_xnd
    if {[expr %t-$bind_xnd(b2-time)]<1000} {
        %W insert insert [selection_if_any]
         global btp
        set btp(lastkill) 0.0
        set btp(prevcmd) mouse-insert
        }
    }

    # only one mouse, so no need have separate vars for each widget
    set bind_xnd(txnd) 0
    set bind_xnd(xdelay) 100
    proc bind_textB1motion  { w loc } {
    global bind_xnd

    set ypos [lindex [split $loc ","] 1]
    if {$ypos > [winfo height $w]} {
        if {!$bind_xnd(txnd)} {after $bind_xnd(xdelay) bind_textExtend $w}
        set bind_xnd(txnd) 1
        set bind_xnd(direction) down
    } elseif {$ypos < 0} {
        if {!$bind_xnd(txnd)} {after $bind_xnd(xdelay) bind_textExtend $w}
        set bind_xnd(txnd) 1
        set bind_xnd(direction) up
    } else {
        set bind_xnd(txnd) 0
        set bind_xnd(direction) 0
    }

    if {!$bind_xnd(txnd)} {
        tk_textSelectTo $w $loc
    }

    }

    bind $tw <ButtonRelease-1> {
        global bind_xnd btp
        set bind_xnd(txnd) 0
    set btp(lastkill) 0.0
    set btp(prevcmd) mouse-select
    }

    proc bind_textExtend { w } {
     global bind_xnd

     if {$bind_xnd(txnd)} {
         if {$bind_xnd(direction) == "down"} {
         tk_textSelectTo $w sel.last+1l
         $w yview -pickplace sel.last+1l
         } elseif {$bind_xnd(direction) == "up"} {
         tk_textSelectTo $w sel.first-1l
         $w yview -pickplace sel.first-1l
         } else { return }
         after $bind_xnd(xdelay) bind_textExtend $w
     }
    }

}

proc bind_emacstext { tw } {
    global btp

    # make Escape key simulate a state Alt key
    bind $tw <Escape> { }
    bind $tw <Escape><Any-KeyPress> {
        global btp
    if {"%A" != ""} {eval $btp(beep) }
    }

    bind $tw <Control-a> {bt:begin-line %W}
    bind $tw <Control-e> {bt:end-line %W}
    bind $tw <Control-f> {bt:move-char %W 1}
    bind $tw <Control-b> {bt:move-char %W -1}
    bind $tw <Escape><f> {bt:move-word %W 1}
    bind $tw <Escape><b> {bt:move-word %W -1}

    bind $tw <Control-n> {bt:move-line %W 1}
    bind $tw <Control-p> {bt:move-line %W -1}
    bind $tw <Control-l> {
    %W yview -pickplace insert
    }
    bind $tw <Control-o> {bt:open-line %W 1}
    bind $tw <Control-d> {bt:delete-back-char-or-sel %W -1}
    bind $tw <Escape><d> {bt:delete-word %W 1}

    bind $tw <Control-h> {bt:delete-back-char-or-sel %W -1}

    bind $tw <Control-k> {bt:delete-line %W 0}
    bind $tw <Control-w> {bt:delete-region-or-sel %W}
    bind $tw <Escape><w> {bt:copy-region-or-sel %W}
    bind $tw <Control-y> {bt:yank %W}
    bind $tw <Escape><y> {bt:yank-pop %W}
    bind $tw <Control-space> {bt:set-mark %W}

    bind $tw <Control-u> {bt:univ-arg %W}
    bind $tw <KeyPress-0> {bt:numkey %W %A}
    bind $tw <KeyPress-1> {bt:numkey %W %A}
    bind $tw <KeyPress-2> {bt:numkey %W %A}
    bind $tw <KeyPress-3> {bt:numkey %W %A}
    bind $tw <KeyPress-4> {bt:numkey %W %A}
    bind $tw <KeyPress-5> {bt:numkey %W %A}
    bind $tw <KeyPress-6> {bt:numkey %W %A}
    bind $tw <KeyPress-7> {bt:numkey %W %A}
    bind $tw <KeyPress-8> {bt:numkey %W %A}
    bind $tw <KeyPress-9> {bt:numkey %W %A}

    bind $tw <Escape><KeyPress-0> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-1> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-2> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-3> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-4> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-5> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-6> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-7> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-8> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-9> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-minus> {bt:argkey %W %A}

    # make C-x key a state
    bind $tw <Control-x> { }
    bind $tw <Control-x><Any-KeyPress> {
        global btp
    if {"%A" != ""} {eval $btp(beep) }
    }
    bind $tw <Control-x><Control-x> {bt:exchange-point-and-mark %W}
    bind $tw <Control-x><KeyPress-f> {bt:set-fill-col %W}

    # Make Meta key like and Escape prefix
    if {$btp(use-meta)} {
    bind $tw <Meta-KeyPress> {
        global btp
        if {"%A" != ""} {eval $btp(beep) }
    }
    bind $tw <Control-Meta-KeyPress> {
        global btp
        if {"%A" != ""} {eval $btp(beep) }
    }

    bind $tw <Meta-f> {bt:move-word %W 1}
    bind $tw <Meta-b> {bt:move-word %W -1}
    bind $tw <Meta-d> {bt:delete-word %W 1}
    bind $tw <Meta-w> {bt:copy-region-or-sel %W}
    bind $tw <Meta-y> {bt:yank-pop %W}

    bind $tw <Meta-0> {bt:argkey %W %A}
    bind $tw <Meta-1> {bt:argkey %W %A}
    bind $tw <Meta-2> {bt:argkey %W %A}
    bind $tw <Meta-3> {bt:argkey %W %A}
    bind $tw <Meta-4> {bt:argkey %W %A}
    bind $tw <Meta-5> {bt:argkey %W %A}
    bind $tw <Meta-6> {bt:argkey %W %A}
    bind $tw <Meta-7> {bt:argkey %W %A}
    bind $tw <Meta-8> {bt:argkey %W %A}
    bind $tw <Meta-9> {bt:argkey %W %A}
    bind $tw <Meta-minus> {bt:argkey %W %A}
    }
}

##############
# ENTRY WIDGET
##############

proc be:move-char {w {num 1} } {
    global btp
    set btp(lastkill-entry) -1
    if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
    }
    $w select clear
    $w icursor [expr {[$w index insert] + $num}]
    tk_entrySeeCaret $w
    set btp(prevcmd) move-char
}

proc be:move-word {w {num 1}} {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
    }
    if {$num > 0} {
        for {set i 0} {$i < $num } {incr i} {
        set endx [expr [$w index insert]+1]
        set estr [$w get]
        while {$endx < [string length $estr] &&
          [regexp $btp(not-word) [string index $estr $endx]]} {
            incr endx
        }
        while {$endx < [string length $estr] &&
          ![regexp $btp(not-word) [string index $estr $endx]]} {
            incr endx
        }
        $w icursor $endx
    }
    } else {
        for {set i 0} {$i > $num } {incr i -1} {
        set endx [expr [$w index insert]-2]
        set estr [$w get]
        while {$endx > 0 &&
           [regexp $btp(not-word) [string index $estr $endx]]} {
            incr endx -1
        }
        while {$endx > 0 &&
           ![regexp $btp(not-word) [string index $estr $endx]]} {
            incr endx -1
        }
        if {$endx > 1} {incr endx}
        $w icursor $endx
    }
    }
    tk_entrySeeCaret $w
    set btp(prevcmd) "move-word"
}

proc be:begin-line { w } {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    $w icursor 0
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) begin-line
}

proc be:end-line { w } {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    $w icursor end
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) end-line
}

proc be:delete-back-char-or-sel { w {num 1} } {
    global btp
    set btp(lastkill-entry) -1
    if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
    }
    if {[catch {$w delete sel.first sel.last}] != 0} {
        set x [expr [$w index insert] - $num]
        catch {$w delete $x}
    tk_entrySeeCaret $w
    }
    set btp(prevcmd) delete-back-char-or-sel
}

proc be:delete-word { w {num 1}} {
    global btp
    $w select clear
    if {$btp(lastkill-entry) == [$w index insert]} {
    set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    be:move-word $w $num
    set endx [$w index insert]
    if {$beg < $endx} {
    incr endx -1
    bt:push-cut "$lastcut[string range [$w get] $beg $endx]"
    $w delete $beg $endx
    } else {
    incr beg -1
    bt:push-cut "[string range [$w get] $endx $beg]$lastcut"
    $w delete $endx $beg
    }
    set btp(lastkill-entry) [$w index insert]
    tk_entrySeeCaret $w
    set btp(prevcmd) delete-word
}

proc be:delete-line { w } {
    global btp
    if {$btp(lastkill-entry) == [$w index insert]} {
    set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    $w select clear
    bt:push-cut "$lastcut[string range [$w get] [$w index insert] end]"
    $w delete [$w index insert] end
    set btp(lastkill-entry) [$w index insert]
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) delete-line
}

proc be:delete-region-or-sel { w } {
    global btp
    if {[catch "$w index sel.first"]} {
    $btp(error) "Sorry! No emacs mark for entries yet!"
    } else {
    bt:push-cut [selection_if_any]
    $w delete sel.first sel.last
    }
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

proc be:copy-region-or-sel { w } {
    global btp
    if {[catch "$w index sel.first"]} {
    $btp(error) "Sorry! No emacs mark for entries yet!"
    } else {
    bt:push-cut [selection_if_any]
    $w select clear
    }
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(arg) def
    set btp(prevcmd) copy-region-or-sel
}

proc be:append-next-kill { w } {
    global btp
    set btp(lastkill-entry) [$w index insert]
}

proc be:yank { w {num 1}} {
    global btp
    $w select clear
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    set btp(lastkill-entry) -1
    set btp(entry-yank-mark) [$w index insert]
    $w insert insert [bt:get-cut $num]
    tk_entrySeeCaret $w
    set btp(prevcmd) yank
}

proc be:yank-pop { w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
    }
    if {$btp(prevcmd) != "yank"} return
    $w select clear
    $w delete $btp(entry-yank-mark) [expr [$w index insert]-1]
    $w insert insert [bt:get-cut [expr $num+1]]
    tk_entrySeeCaret $w
}

proc be:set-mark { w } {
    global btp
    $btp(error) "Sorry! No emacs mark for entries yet!"
}


proc be:exchange-point-and-mark { w } {
    global btp
    $btp(error) "Sorry! No emacs mark for entries yet!"
}

proc be:argkey { w a } {
    global btp
    set btp(arg) $a
}

proc be:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
    catch {%W delete sel.first sel.last}
    $w insert insert $a
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(prevcmd) self-insert
    } else {
    if {$a == "-"} {
        if {$btp(arg) == "-"} {
        set btp(arg) "0"
        } elseif {$btp(arg) == "0"} {
        set btp(arg) "-"
        } else {
        set btp(arg) [expr -1*$btp(arg)]
        }
    } else {
        append btp(arg) $a
    }
    }
}

proc be:univ-arg { w } {
    global btp
    if {$btp(arg) == "def"} {
    set btp(arg) 4
    } else {
    if {$btp(arg) == "-"} {
        set btp(arg) "-4"
    } else {
        set btp(arg) [expr 4*$btp(arg)]
    }
    }
}

proc bind_motifentry { ew } {
    global bind_xnd

    bind $ew <Control-KeyPress> {
        global btp
    if {"%A" != ""} {eval $btp(beep) }
    }

    bind $ew <Delete> {be:delete-back-char-or-sel %W -1}
    bind $ew <BackSpace> {be:delete-back-char-or-sel %W 1}
    bind $ew <Left> {be:move-char %W -1}
    bind $ew <Right> {be:move-char %W 1}
    bind $ew <Control-Left> {be:move-word %W -1}
    bind $ew <Control-Right> {be:move-word %W 1}
    bind $ew <Home> {be:begin-line %W}
    bind $ew <End> {be:end-line %W}

    bind $ew <Any-KeyPress> {
        global btp
    if {"%A" != ""} {
        catch {%W delete sel.first sel.last}
        %W insert insert %A
        tk_entrySeeCaret %W
        set btp(lastkill-entry) -1
        set btp(prevcmd) self-insert
    }
    }

    bind $ew <1> "[bind Entry <1>]; \
                  global btp; set btp(lastkill-entry) -1; \
          set btp(prevcmd) mouse-set"
    bind $ew <Double-Button-1> {%W select from 0; %W select to end}
    bind $ew <3> {%W select clear}
    bind $ew <Shift-2> {%W scan mark %x}
    bind $ew <Shift-B2-Motion> {%W scan dragto %x}

    set bind_xnd(b2-time) 0
    bind $ew <2> {
        global bind_xnd
        %W scan mark %x
        set bind_xnd(b2-time) %t
    }
    bind $ew <ButtonRelease-2> {
        global bind_xnd btp
    if {[expr %t-$bind_xnd(b2-time)]<1000} {
        set btp(lastkill-entry) -1
        %W insert insert [selection_if_any]
         set btp(prevcmd) mouse-insert
        }
    }

}

proc bind_emacsentry { ew } {
    global btp

    # make Escape key simulate Alt key
    bind $ew <Escape> { }
    bind $ew <Escape><Any-KeyPress> {
        global btp
    if {"%A" != ""} {eval $btp(beep) }
    }

    bind $ew <KeyPress-0> {be:numkey %W %A}
    bind $ew <KeyPress-1> {be:numkey %W %A}
    bind $ew <KeyPress-2> {be:numkey %W %A}
    bind $ew <KeyPress-3> {be:numkey %W %A}
    bind $ew <KeyPress-4> {be:numkey %W %A}
    bind $ew <KeyPress-5> {be:numkey %W %A}
    bind $ew <KeyPress-6> {be:numkey %W %A}
    bind $ew <KeyPress-7> {be:numkey %W %A}
    bind $ew <KeyPress-8> {be:numkey %W %A}
    bind $ew <KeyPress-9> {be:numkey %W %A}

    bind $ew <Control-u> {be:univ-arg %W}
    bind $ew <Escape><KeyPress-0> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-1> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-2> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-3> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-4> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-5> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-6> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-7> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-8> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-9> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-minus> {be:argkey %W %A}

    bind $ew <Control-a> {be:begin-line %W}
    bind $ew <Control-e> {be:end-line %W}
    bind $ew <Control-b> {be:move-char %W -1}
    bind $ew <Control-f> {be:move-char %W 1}
    bind $ew <Escape><b> {be:move-word %W -1}
    bind $ew <Escape><f> {be:move-word %W 1}

    bind $ew <Control-l> {
    tk_entrySeeCaret %W
    }

    bind $ew <Control-d> {be:delete-back-char-or-sel %W 0}
    bind $ew <Escape><KeyPress-d> {be:delete-word %W 1}
    bind $ew <Control-k> {be:delete-line %W}
    bind $ew <Control-w> {be:delete-region-or-sel %W}
    bind $ew <Escape><KeyPress-w> {be:copy-region-or-sel %W}
    bind $ew <Control-y> {be:yank %W}
    bind $ew <Escape><KeyPress-y> {be:yank-pop %W}
    bind $ew <Control-space> {be:set-mark %W}

    bind $ew <Control-h> {be:delete-back-char-or-sel %W 1}

    # make C-x key a state
    bind $ew <Control-x> { }
    bind $ew <Control-x><Any-KeyPress> {
        global btp
    if {"%A" != ""} {eval $btp(beep) }
    }
    bind $ew <Control-x><Control-x> {be:exchange-point-and-mark %W}

    # Make Meta key like and Escape prefix
    if {$btp(use-meta)} {
    bind $ew <Meta-KeyPress> {
        global btp
        if {"%A" != ""} {eval $btp(beep) }
    }
    bind $ew <Control-Meta-KeyPress> {
        global btp
        if {"%A" != ""} {eval $btp(beep) }
    }
        bind $ew <Meta-b> {be:move-word %W -1}
        bind $ew <Meta-f> {be:move-word %W 1}
        bind $ew <Meta-d> {be:delete-word %W 1}
    bind $ew <Meta-w> {be:copy-region-or-sel %W}
    bind $ew <Meta-y> {be:yank-pop %W}

    bind $ew <Meta-0> {be:argkey %W %A}
    bind $ew <Meta-1> {be:argkey %W %A}
    bind $ew <Meta-2> {be:argkey %W %A}
    bind $ew <Meta-3> {be:argkey %W %A}
    bind $ew <Meta-4> {be:argkey %W %A}
    bind $ew <Meta-5> {be:argkey %W %A}
    bind $ew <Meta-6> {be:argkey %W %A}
    bind $ew <Meta-7> {be:argkey %W %A}
    bind $ew <Meta-8> {be:argkey %W %A}
    bind $ew <Meta-9> {be:argkey %W %A}
    bind $ew <Meta-minus> {be:argkey %W %A}
    }
}